home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / sound.pas < prev    next >
Pascal/Delphi Source File  |  1986-02-15  |  3KB  |  121 lines
  1. program SoundDemo;
  2. {$C-}
  3. {
  4.             SOUND DEMONSTRATION PROGRAM  Version 1.00A
  5.  
  6.  This program demonstrates TURBO PASCAL's standard procedures Sound,
  7.  Delay and NoSound on the IBM PC and true compatibles.
  8.  
  9.  PSEUDO CODE
  10.  1.  Sound an alarm until a key is pressed.
  11.      a. Play G and D in octave 4
  12.  2.  Sound a siren until a key is pressed.
  13.  
  14.  
  15.  INSTRUCTIONS
  16.  1.  Compile and run this program using the TURBO.COM compiler.
  17.  2.  Type any key to stop the alarm.
  18.  3.  Type any key to stop the siren and end the program.
  19.  
  20. }
  21.  
  22. type
  23.   NoteRecord = record
  24.                   C,CF,D,DF,E,F,FF,G,GF,A,AF,B: integer;
  25.                end;
  26.  
  27. const
  28.   Notes: NoteRecord =
  29.           (C:1;CF:2;D:3;DF:4;E:5;F:6;FF:7;G:8;GF:9;A:10;AF:11;B:12);
  30.  
  31. var
  32.   ch : char;
  33.  
  34. procedure Play(Octave,Note,Duration: integer);
  35.  
  36. { Play Note in Octave Duration milliseconds
  37.   Frequency computed by first computing C in
  38.   Octave then increasing frequency by Note-1
  39.   times the twelfth root of 2. (1.059463994)
  40.  
  41.   If Duration is zero  Note will be played
  42.   until you activate procedure NoSound       }
  43.  
  44. var
  45.   Frequency : real;
  46.   I         : integer;
  47. begin
  48.   Frequency := 32.625;
  49.   for I := 1 to Octave do                { Compute C in Octave             }
  50.     Frequency := Frequency * 2;
  51.   for I := 1 to Note - 1 do              { Increase frequency Note-1 times }
  52.     Frequency := Frequency * 1.059463094;
  53.   if Duration <> 0 then
  54.   begin
  55.     Sound(Round(Frequency));
  56.     Delay(Duration);
  57.     NoSound;
  58.   end
  59.   else Sound(Round(Frequency));
  60. end;
  61.  
  62.  
  63. procedure SoftAlarm;
  64. { Play the notes G and D in octave three 7 times
  65.  each with a duration of 70 milliseconds.       }
  66. var
  67.   I: integer;
  68. begin
  69.   for I := 1 to 7 do
  70.     with Notes do
  71.     begin
  72.       Play(4,G,70);
  73.       Play(4,D,70);
  74.     end;
  75.     delay(1000);
  76. end;
  77.  
  78.  
  79. procedure Siren;
  80. var
  81.   Frequency: integer;
  82. begin
  83.   for Frequency := 500 to 2000 do
  84.   begin
  85.     Delay(1);
  86.     Sound(Frequency);
  87.   end;
  88.   for Frequency := 2000 downto 500 do
  89.   begin
  90.     Delay(1);
  91.     Sound(Frequency);
  92.   end;
  93.   NoSound;
  94. end;
  95.  
  96.  
  97. procedure SoundAlarm;
  98. begin
  99.   Writeln('Press any key to Stop');
  100.   repeat
  101.     SoftAlarm
  102.   until KeyPressed;
  103.   Read(kbd,ch);
  104. end; {SoundAlarm}
  105.  
  106.  
  107. procedure SoundSiren;
  108. begin
  109.   Writeln('Press any key to Stop');
  110.   repeat
  111.     Siren
  112.   until KeyPressed;
  113.   Read(kbd,ch)
  114. end; {SoundSiren}
  115.  
  116.  
  117. begin
  118.   SoundAlarm;
  119.   SoundSiren;
  120. end.
  121.